home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 7
/
Apprentice-Release7.iso
/
Environments
/
PowerLisp 2.01
/
PowerLisp 2.01 ƒ
/
Library
/
graphics.lisp
< prev
next >
Wrap
Lisp/Scheme
|
1996-05-17
|
3KB
|
127 lines
;;;
;;; PowerLisp 2.0
;;; Copyright © 1996 Roger Corman. All rights reserved.
;;;; PowerLisp graphics routines
;;;;
(defpackage graphics
(:use :common-lisp)
(:export
open-canvas
use-canvas
moveto
lineto
setcolor
pensize
fillrect
aafillpoly
fillpoly
clear-canvas
filled-ellipse))
(in-package :graphics)
(provide :graphics)
(defvar *current-point* nil)
(defvar *current-color* nil)
(defun open-canvas (canvas-name &key (width 320) (height 240) (depth 0))
"Usage: (open-canvas canvas-name :width w :height h)
Creates a canvas with the requested name."
(%new-canvas canvas-name width height depth)
(setq *current-point* nil))
(defun use-canvas (canvas-name)
"Usage: (use-canvas canvas-name)
Makes the requested canvas the current canvas."
(setq *current-point* nil)
(%set-current-canvas canvas-name))
(defun moveto (x y)
"Usage: (moveto x y)
x and y should be integers and are relative to the upper left
corner of the canvas."
(setq *current-point* (cons x y)))
(defun lineto (x y)
"Usage: (lineto x y)
x and y should be integers and are relative to the upper left
corner of the canvas."
(unless *current-point*
(error "No current point"))
(%line (car *current-point*) (cdr *current-point*) x y)
(setq *current-point* (cons x y)))
(defun setcolor (r g b)
"Usage: (setcolor red green blue)
Sets the current canvas color to the requested RGB color.
Red, green and blue should be between 0.0 and 1.0"
(let ((red (truncate (* r 65535)))
(green (truncate (* g 65535)))
(blue (truncate (* b 65535))))
(%rgbforecolor red green blue)
(setq *current-color* (list red green blue))))
(defun pensize (size)
"Usage: (pensize size)
The current canvas pen size is set to the requested dimension.
size should be an integer."
(%pensize size size))
(defun fillrect (x1 y1 x2 y2)
"Usage: (fillrect x1 y1 x2 y2)
A filled rectangle as drawn on the current canvas, using
the current color."
(%fill-polygon `((,x1 . ,y1) (,x2 . ,y1) (,x2 . ,y2) (,x1 . ,y2))))
(defun fillpoly (&rest points)
"Usage: (fillpoly points)
A filled polygon as drawn on the current canvas, using
the current color.
The points list is a list of cons pairs where each cons contains
two integers (x and y)."
(%fill-polygon points))
(defun aafillpoly (&rest points)
"Usage: (aafillpoly points)
A filled anti-aliased polygon as drawn on the current canvas, using
the current color.
The points list is a list of cons pairs where each cons contains
two integers (x and y)."
(%aarender (list points)))
(defun clear-canvas ()
"Usage: (clear-canvas)
The current canvas is erased."
(%erase-canvas))
(defun filled-ellipse (x1 y1 x2 y2)
"Usage: (filled-ellipse x1 y1 x2 y2)
A filled anti-aliased ellipse is drawn on the current canvas
in the current color."
(%aaellipse `((,x1 . ,y1) (,x2 . ,y2))))
;;;; Import all these symbols into Common Lisp package
(in-package :powerlisp)
(use-package :graphics)